home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / DualScroll / dualscroll.p
Text File  |  1997-05-06  |  5KB  |  214 lines
  1. {
  2.   *  DualScroll, converted from Modula2 to PCQ-Pascal 03/1993 by Diesel  *
  3.   *  Grundlage war ursprünglich ein C-Proggy von Gregg Williams.         *
  4.   *                                     *
  5.   *  Playfield 1 ist ein ganz normaler Intuition-Screen, Playfield 2     *
  6.   *  dagegen eine übergroße Bitmap (640*512 Punkte ohne Interlace), die  *
  7.   *  lustig durch die Gegend scrollt.                     *
  8. }
  9.  
  10. Program DPFDemo;
  11.  
  12. {$I "Include:intuition/intuition.i" }
  13. {$I "Include:graphics/areas.i" }
  14. {$I "Include:graphics/pens.i" }
  15. {$I "Include:exec/libraries.i" }
  16. {$I "Include:exec/memory.i" }
  17. {$I "Include:libraries/dos.i" }
  18.  
  19. CONST
  20.   Farben : Array[1..32] OF Short = (
  21.     $000, $E3F, $000, $CE7, $000, $000, $000, $000,
  22.     $000, $FB0, $CCC, $F19, $270, $0C5, $777, $338,
  23.     $000, $000, $000, $000, $000, $000, $000, $000,  
  24.     $000, $000, $000, $000, $000, $000, $000, $000);  
  25.  
  26.  
  27. VAR BMap    : BitMapPtr;            {  2. Bitmap  }
  28.     RInfo    : ARRAY[0..1] OF RasInfo;    {  1. + 2. RasInfo  }
  29.     RP        : ARRAY[0..1] OF RastPortPtr;    {  1. + 2. RastPort  }
  30.     i,x,y    : INTEGER;
  31.     ScreenDaten    : NewScreen;
  32.     MeinScreen    : ScreenPtr;
  33.     GfxBase    : Address;                    
  34.  
  35.  
  36. { -------------------------------------------------------------------- }
  37.  
  38. Function LeftMouseButton: Boolean;
  39. Type
  40.     bt = ^Byte;
  41. Var
  42.     bfe : bt;
  43. Begin
  44.     bfe := Address($bfe001);
  45.  
  46.     If (bfe^ MOD 128) > 64            { bit 6 gesetzt ? }
  47.     then  LeftMouseButton := False        { ja -> nicht gedrückt }
  48.     else  LeftMouseButton := True;        { nein -> lmb gedrückt }
  49. end;
  50.  
  51.  
  52. PROCEDURE MakeBox(x1,y1,col1,col2: INTEGER);
  53. BEGIN
  54.     SetAPen(  RP[1] ,0);        {  Schatten zeichnen  }
  55.     RectFill( RP[1] ,x1+4,y1+4,x1+40,y1+40);
  56.  
  57.     SetAPen(  RP[1] ,0);        {  Umrandung zeichnen  }
  58.     RectFill( RP[1] ,x1,y1,x1+36,y1+36);
  59.  
  60.     SetAPen(  RP[1] ,col1);        {  großen Kasten zeichnen  }
  61.     RectFill( RP[1] ,x1+2,y1+2,x1+34,y1+34);
  62.  
  63.     SetAPen(  RP[1] ,col2);        {  kleinen Kasten zeichnen  }
  64.     RectFill( RP[1] ,x1+12,y1+12,x1+24,y1+24);
  65. END;    { MakeBox }
  66.  
  67.   
  68. PROCEDURE ZeichneFields;
  69. VAR x1,y1,temp,col1,col2: INTEGER;
  70. BEGIN
  71.                 {  Fenster auf 1. Playfield malen  }
  72.     SetRast(  RP[0], 1);    {  alles erstmal in Blau  }
  73.  
  74.     SetAPen(  RP[0], 0);
  75.     RectFill( RP[0], 20,20,60,60);
  76.     RectFill( RP[0], 262,195,302,235);
  77.  
  78.     SetAPen(  RP[0], 2);        { Rahmen }
  79.     RectFill( RP[0], 95,45,225,183);
  80.  
  81.     SetAPen(  RP[0], 0);        { Fenster }
  82.     RectFill( RP[0], 100,50,220,178);
  83.     
  84.     SetRast(  RP[1], 15);
  85.     SetAPen(  RP[1], 14);
  86.     
  87.     temp:=1;
  88.     FOR x1:=0 TO 640 DO {  Übergroßes Playfield 2 mit Gitter füllen  }
  89.     BEGIN
  90.       x1 := x1 + 19;                { Step 20 }
  91.       Move( RP[1], x1, 0);
  92.       Draw( RP[1], x1, 512);
  93.     END;
  94.     FOR y1:=0 TO 512 DO
  95.     BEGIN
  96.       y1 := y1 + 19;                { Step 20 }
  97.       Move( RP[1],   0, y1 );
  98.       Draw( RP[1], 640, y1 );
  99.     END;
  100.     
  101.     FOR x1:=25 TO 590 DO {  Übergroßes Playfield 2 mit Kästen füllen  }
  102.     BEGIN
  103.       x1 := x1+49;                { Step 50 }
  104.       FOR y1:=0 TO 462 DO
  105.       BEGIN
  106.     y1 := y1+49;                { Step 50 }
  107.         col1:=temp+8;
  108.         INC(temp);
  109.         IF temp>7 THEN temp:=1;
  110.  
  111.         col2:=temp+8;
  112.         INC(temp);
  113.         IF temp>7 THEN temp:=1;
  114.  
  115.         MakeBox(x1,y1,col1,col2);
  116.       END;
  117.     END;
  118. END;  { ZeichneFields }
  119.   
  120.  
  121.  { ---- MAIN ---- }
  122.  
  123. BEGIN
  124.   GfxBase := OpenLibrary( "graphics.library", 32 );
  125.   If GfxBase=NIL THEN Exit(20);
  126.  
  127.  
  128.   New( BMap );
  129.   New( RP[0] );
  130.   New( RP[1] );
  131.  
  132.  
  133.   WITH ScreenDaten DO
  134.   BEGIN
  135.     leftEdge:=0;
  136.     topEdge:=0;
  137.     width:=322;
  138.     height:=256;
  139.     depth:=3;
  140.     detailPen:=0;
  141.     blockPen:=1;
  142.     viewModes:= 0;
  143.     Stype:=customScreen_f;
  144.     defaultTitle:=NIL;
  145.     gadgets:=NIL;
  146.     font:=NIL;
  147.     customBitMap:=NIL;
  148.   END;
  149.   
  150.   MeinScreen:=OpenScreen( ADR(ScreenDaten));
  151.  
  152.   InitBitMap(BMap,3,640,512); {  Bitmap 2 initialisieren  }
  153.  
  154.   FOR i:=0 TO 2 DO
  155.   BEGIN
  156.     BMap^.planes[i]:=AllocRaster(640,512); {  Bitplanes reservieren  }
  157.   END;
  158.  
  159.   InitRastPort( RP[1] );            {  RastPort 2 erstellen  }
  160.   RP[1]^.bitMap := BMap;            {  Bitmap 2 einbinden  }
  161.  
  162.   WITH RInfo[1] DO                {  RasInfo 2 ausfüllen  }
  163.   BEGIN
  164.     bitMap:=BMap; rxOffset:=0; ryOffset:=0; next:=NIL;
  165.   END;
  166.  
  167.                     {  RastPort u. RasInfo deklarieren  }
  168.   CopyMem( Adr(MeinScreen^.SrastPort), RP[0], SizeOf(RastPort) );
  169.   RInfo[0].next := MeinScreen^.SViewPort.rasInfo^.next;
  170.   MeinScreen^.SviewPort.rasInfo^.next:=ADR( RInfo[1] );    {  RasInfo 2 anpassen  }
  171.  
  172.   LoadRGB4(ADR(MeinScreen^.SviewPort),ADR(Farben),32);    {  Farben laden  }
  173.     
  174.   MeinScreen^.SviewPort.modes := DualPF;        {  DUALPF setzen  }
  175.  
  176.   MakeScreen(MeinScreen);                {  erneuern  }
  177.   RethinkDisplay;
  178.  
  179.   ZeichneFields;      {  Playfields füllen  }
  180.  
  181.   x:=1; y:=1;
  182.   
  183.   REPEAT
  184.     RInfo[1].rxOffset:=RInfo[1].rxOffset+x;    {  Koordinaten f. PF2 erhöhen  }
  185.     RInfo[1].ryOffset:=RInfo[1].ryOffset+y;
  186.     
  187.     IF (RInfo[1].rxOffset<=0) OR (RInfo[1].rxOffset>=319) THEN
  188.     BEGIN
  189.       x:=-x;
  190.     END;
  191.  
  192.     IF (RInfo[1].ryOffset<=0) OR (RInfo[1].ryOffset>=255) THEN
  193.     BEGIN
  194.       y:=-y;
  195.     END;
  196.     RemakeDisplay;                {  Display erneuern  }
  197.   UNTIL LeftMouseButton;
  198.  
  199.   MeinScreen^.SviewPort.rasInfo^.next := NIL;    {  Intuition-Screen setzen  }
  200.   MeinScreen^.SviewPort.modes := 0;        {  DUALPF löschen  }
  201.   
  202.   MakeScreen(MeinScreen);            {  OK !  }
  203.   RemakeDisplay;                 
  204.   RethinkDisplay;
  205.  
  206.   CloseScreen(MeinScreen);
  207.   FOR i:=0 TO 2 DO                {  2. Bitmap freigeben  }
  208.   BEGIN
  209.     FreeRaster(BMap^.planes[i],640,512);
  210.   END;
  211.   CloseLibrary( GfxBase );
  212.  
  213. END.
  214.